home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / Borland Visual dBASE Professiona v7.0 / DATA1.CAB / Sample_dBASE / Registry.prg < prev    next >
Text File  |  1997-11-20  |  13KB  |  416 lines
  1. //------------------------------------------------------------------------
  2. //
  3. //  Registry.prg  --  Windows 32 System Registry Class
  4. //
  5. //  The registry program contains the class definition for the 
  6. //  Registry class. Using this class you can read and write 
  7. //  values in the Windows 32 registry.
  8. //
  9. //  Syntax:                                                                    
  10. //
  11. //    new Registry(<openKey>, <subKey>);
  12. //
  13. //    where <openKey> is a numeric value containing the handle to open
  14. //                    registry key. This will typically be one of the
  15. //                    system keys defined in WINREG.H.
  16. //          <subKey> is a character string containing the name of a
  17. //                   subkey of <openKey>.
  18. //
  19. //  Properties:
  20. //
  21. //    error         -  Contains the Windows error number if an error 
  22. //                     occured during the last registry operation. 
  23. //                     Contains 0 if no error occured.
  24. //    newlyCreated  -  Set during instantiation. True if this is a 
  25. //                     new key, false otherwise.
  26. //
  27. // Methods:
  28. //
  29. //    deleteValue([<name>]) - Delete the named value from the current 
  30. //                            key. If no name is passed, then the 
  31. //                            default value for this key is deleted.
  32. //
  33. //    enumValue() - Returns an array containing the names of each 
  34. //                  value contained in the current key.
  35. // 
  36. //    queryKeyName() - Returns the name of the current registry key.
  37. // 
  38. //    queryValue(<name>) - Returns the value associated with <name>. The
  39. //                        <name> parameter is required, but may be blank.
  40. //                         If blank the default value for the key is
  41. //                         returned.
  42. // 
  43. //    setValue(<name>,<value>[,<type>])
  44. //                       - Sets the value of <name> to <value>. Both
  45. //                         parameters are required, but <name> may be
  46. //                         blank to set the default value for the key.
  47. //                         Returns a logical true or false to indicate
  48. //                         success or failure, respectively. If no type
  49. //                         is indicated, the value is saved. The types
  50. //                         are defined in WINREG.H.
  51. //
  52. // Example: Using the Registry class to set the DBASE table 
  53. //          creation level to 7
  54. //
  55. /*
  56.   #include <winreg.h>
  57.   #define BDE_REG_KEY "SOFTWARE\Borland\Database Engine"
  58.   SET PROCEDURE TO "registry.prg" ADDITIVE
  59.  
  60.   reg = new Registry(HKEY_LOCAL_MACHINE, ;
  61.                      BDE_REG_KEY + ;
  62.                      "\Settings\DRIVERS\DBASE\TABLE CREATE" )
  63.   dbfLevel = reg.queryValue("LEVEL")
  64.  
  65.   if ( reg.error == 0 )
  66.      if ( dbfLevel <> "7" )
  67.         if (reg.setValue("LEVEL","7")) 
  68.            MSGBOX("dBASE table level set to 7.")
  69.         endif
  70.      endif
  71.   else 
  72.      MSGBOX("Error reading registry.")
  73.   endif
  74. */
  75. // 
  76. //
  77. //  Visual dBASE Samples Group
  78. //  $Revision:   1.6  $
  79. //
  80. //  Copyright (c) 1997, Borland International, Inc. All rights reserved.
  81. // 
  82. //------------------------------------------------------------------------
  83. //
  84. //
  85. //  These next two lines are used for debugging purposes. To trace the
  86. //  results of the API calls, uncomment the #define DEBUG line. The
  87. //  results are written to the Command window.
  88. //
  89. //#define DEBUG
  90.  
  91. // Define Windows data types for use by the extern command
  92. #include <windef.h>
  93. #include <winreg.h>
  94.  
  95. class Registry(openKey, subKey)
  96.    this.openKey = openKey
  97.    this.subKey  = subKey
  98.    this.key     = 0
  99.    this.isOpen  = false
  100.    this.error   = 0
  101.    this.newlyCreated = false
  102.  
  103.    class::prototype()
  104.  
  105.    local nKey, nDisposition, nResult
  106.    nKey         = 0
  107.    nDisposition = -1
  108.    nResult      = RegCreateKeyEx( this.openKey, this.subKey, 0, 0, REG_OPTION_NON_VOLATILE,  KEY_ALL_ACCESS, 0, nKey, nDisposition )
  109.  
  110. #ifdef DEBUG
  111. ? "constructor - " + nResult
  112. ? "disposition - " + nDisposition
  113. #endif
  114.  
  115.    // store the handle to this key
  116.    this.key := nKey
  117.    // registry keys should not be held open. If we got a key open
  118.    // close it for now.
  119.    if (nResult == ERROR_SUCCESS)
  120.       if (nDisposition == REG_CREATED_NEW_KEY)
  121.          this.newlyCreated := true
  122.       endif
  123.  
  124. #ifdef DEBUG
  125. ? "created - " + this.newlyCreated
  126. #endif
  127.  
  128.       this.close()
  129.    else 
  130.       this.error := nResult
  131.    endif
  132.  
  133.    function close
  134.       this.isOpen := false
  135.       local nResult 
  136.       nResult = RegCloseKey( this.key )
  137.  
  138. #ifdef DEBUG
  139. ? "close - " + nResult
  140. #endif
  141.  
  142.    return (nResult)
  143.  
  144.    function deleteValue(keyName)
  145.       local bReturn, nResult
  146.       bReturn = false
  147.       nResult = 0
  148.  
  149.       // reset the error property
  150.       this.error := 0
  151.  
  152.       // open up the key
  153.       this.open()
  154.  
  155.       if (this.isOpen) 
  156.          bReturn := true
  157.          // if one parameter is passed, delete that value
  158.          if (deleteValue.arguments.length == 1) 
  159.             nResult := RegDeleteValue(this.key, keyName)
  160.             // if no parameter is passed, delete default value
  161.          else 
  162.             nResult := RegDeleteValue(this.key, "")
  163.          endif
  164.  
  165. #ifdef DEBUG
  166. ? "delete - " + nResult
  167. #endif
  168.  
  169.          this.close()
  170.       endif
  171.    return (bReturn)
  172.  
  173.    function enumValue
  174.       local aReturn, nResult, nCount, sValue, nLen, string80
  175.  
  176.       aReturn = new Array()
  177.       nResult = ERROR_SUCCESS
  178.       nCount = 0
  179.       sValue = ""
  180.       nLen = 0
  181.       string80 = REPLICATE(" ", 80)
  182.  
  183.       // reset the error property
  184.       this.error := 0
  185.  
  186.       // open up the key
  187.       this.open()
  188.  
  189.       if (this.isOpen) 
  190.          do while (nResult == ERROR_SUCCESS) 
  191.             sValue  := string80
  192.             nLen    := sValue.length
  193.             nResult := RegEnumValue(this.key, nCount, sValue, ;
  194.                         nLen, 0, 0, 0, 0)
  195.  
  196. #ifdef DEBUG
  197. ? "enum - " + nCount + " - " + nResult
  198. #endif
  199.  
  200.             if ( nResult == ERROR_SUCCESS )
  201.                aReturn.add( SUBSTR( sValue, 0, nLen) )
  202.             else 
  203.                if (nResult <> ERROR_NO_MORE_ITEMS )
  204.                   this.error := nResult
  205.                endif
  206.             endif
  207.             nCount ++               
  208.          enddo           
  209.          this.close()
  210.       endif
  211.    return (aReturn)
  212.  
  213.    function open
  214.       local nResult, nReturn
  215.       nReturn = 0            // handle of new key
  216.       nResult = RegOpenKeyEx( this.openKey, this.subKey, 0, ;
  217.                   KEY_ALL_ACCESS, nReturn)
  218.  
  219. #ifdef DEBUG
  220. ? "open - " + nResult
  221. #endif
  222.  
  223.       if (nResult == ERROR_SUCCESS) 
  224.          this.key = nReturn
  225.          this.isOpen = true
  226.       else
  227.          this.error = (nResult)
  228.       endif
  229.    return (nReturn)
  230.  
  231.    function prototype
  232.       local bAsian
  233.       bAsian = false
  234.       extern CLONG RegCloseKey( HKEY ) ADVAPI32
  235.       extern CLONG RegCreateKeyEx( HKEY, LPCTSTR, DWORD, LPTSTR, DWORD, ;
  236.                    REGSAM, LPSTRUCTURE, PHKEY, LPDWORD ) ADVAPI32 ;
  237.                    from "RegCreateKeyExA"
  238.       extern CLONG RegDeleteValue( HKEY, LPTSTR ) ADVAPI32 ;
  239.                    from "RegDeleteValueA"
  240.       extern CLONG RegEnumValue( HKEY, DWORD, LPTSTR, LPDWORD, DWORD, ;
  241.                    LPDWORD, LPBYTE, LPDWORD) ADVAPI32 from "RegEnumValueA"
  242.       extern CLONG RegOpenKeyEx( HKEY, LPCTSTR, DWORD, REGSAM, PHKEY ) ;
  243.                    ADVAPI32 from "RegOpenKeyExA"
  244.       extern CLONG RegQueryValueEx( HKEY, LPTSTR, DWORD, LPDWORD, CSTRING, ;
  245.                    LPDWORD ) ADVAPI32 from "RegQueryValueExA"
  246.       extern CLONG RegSetValueEx( HKEY, LPCTSTR, DWORD, DWORD, CSTRING, DWORD ) ;
  247.                    ADVAPI32 from "RegSetValueExA"
  248. #ifdef __asian__  
  249.       extern CLONG RegQueryValueExChar( HKEY, LPTSTR, DWORD, LPDWORD, CSTRING, ;
  250.                    LPDWORD ) ADVAPI32 from "RegQueryValueExA"
  251.       extern CLONG RegSetValueExChar( HKEY, LPCTSTR, DWORD, DWORD, CSTRING, DWORD ) ;
  252.                    ADVAPI32 from "RegSetValueExA"
  253.       bAsian := true
  254. #endif
  255.  
  256.    return (bAsian)
  257.  
  258.    function queryKeyName
  259.       local keyName
  260.       keyName = ""
  261.  
  262.       do case
  263.          case ( this.openKey == HKEY_CLASSES_ROOT )
  264.               keyName := "HKEY_CLASSES_ROOT\\"
  265.          case ( this.openKey == HKEY_CURRENT_USER )
  266.               keyName := "HKEY_CURRENT_USER\\"
  267.          case ( this.openKey == HKEY_LOCAL_MACHINE )
  268.                keyName := "HKEY_LOCAL_MACHINE\\"
  269.          case ( this.openKey == HKEY_USERS )
  270.               keyName := "HKEY_USERS\\"
  271.          case ( this.openKey == HKEY_PERFORMANCE_DATA )
  272.               keyName := "HKEY_PERFORMANCE_DATA\\"
  273.          case ( this.openKey == HKEY_CURRENT_CONFIG )
  274.               keyName := "HKEY_CURRENT_CONFIG\\"
  275.          case ( this.openKey == HKEY_DYN_DATA )
  276.               keyName := "HKEY_DYN_DATA\\"
  277.          otherwise
  278.             keyName := "UNKNOWN_KEY\\"
  279.       endcase
  280.  
  281.    return (keyName + this.subKey)
  282.  
  283.    function queryValue(keyName)
  284.       local nResult, nType, nLen, keyValue
  285.       local strEx, cData
  286.       nResult  = 0 
  287.       nType    = 0
  288.       nLen     = 80
  289.       keyValue = false
  290.  
  291.       strEx = ""
  292.       cData = REPLICATE(" ", 80)
  293.  
  294.       // reset the error property
  295.       this.error := 0
  296.  
  297.       // open up the key
  298.       this.open()
  299.  
  300.       if (this.isOpen) 
  301.          // query the value
  302.          nResult := RegQueryValueEx(this.key, keyName, 0, ;
  303.                     nType, cData, nLen)
  304.  
  305. #ifdef DEBUG
  306. ? "query - " + nResult
  307. #endif
  308.  
  309.          // ERROR_MORE_DATA means we need to pass a larger cData
  310.          if (nResult == ERROR_MORE_DATA)
  311.             cData   := REPLICATE(" ", nLen)
  312.             nResult := RegQueryValueEx(this.key, keyName, 0, ;
  313.                        nType, cData, nLen)
  314.  
  315. #ifdef DEBUG
  316. ? "requery - " + nResult
  317. #endif
  318.  
  319.          endif
  320.  
  321. #ifdef __asian__
  322.          // The Asian version uses Unicode strings. Call RegQueryValueExChar, which 
  323.          // is prototyped to char*, which converts the string to multi-byte.
  324.          if ( nResult == ERROR_SUCCESS AND nType == REG_SZ )
  325.             cData   := REPLICATE(" ", nLen)
  326.             nResult := RegQueryValueExChar(this.key, keyName, 0, nType, cData, nLen);
  327.  
  328. #ifdef DEBUG
  329. ? "UNICODE requery - " + nResult
  330. #endif
  331.  
  332.          endif
  333. #endif
  334.  
  335.          strEx := cData
  336.          if (nResult == ERROR_SUCCESS)
  337.             if (nType == REG_DWORD)
  338.                keyValue := strEx.asc(strEx.substring(0, 1)) * ( 256 ^ 0 ) + ;
  339.                            strEx.asc(strEx.substring(1, 2)) * ( 256 ^ 1 ) + ;
  340.                            strEx.asc(strEx.substring(2, 3)) * ( 256 ^ 2 ) + ;
  341.                            strEx.asc(strEx.substring(3, 4)) * ( 256 ^ 3 )
  342.             else 
  343.                keyValue := SUBSTR(strEx, 1, nLen - 1  )
  344.             endif
  345.          else
  346.             this.error := nResult
  347.          endif
  348.          this.close()
  349.       endif
  350.    return (keyValue)
  351.  
  352.    function setValue( valueName, value, type ) 
  353.       local bReturn, nType, xValue, nAtNull, nLen, nResult
  354.       private typeVal
  355.       bReturn = false
  356.       nType   = IIF( PCOUNT() == 3, type, REG_SZ )
  357.       typeVal = value
  358.       xValue  = value
  359.       nAtNull = 0
  360.       nLen    = 0
  361.       nResult = 0
  362.  
  363.       // reset the error property
  364.       this.error := 0
  365.  
  366.       // open the key
  367.       this.open()
  368.  
  369.       if (this.isOpen) 
  370.          // reformat data if necessary
  371.          if (nType == REG_DWORD) 
  372.             if TYPE("typeVal") == "C"
  373.                xValue := VAL(value)
  374.             endif
  375.             xValue := CHR( INT( xValue / ( 256 ^ 0 ) ) % 256) + ;
  376.                       CHR( INT( xValue / ( 256 ^ 1 ) ) % 256) + ;
  377.                       CHR( INT( xValue / ( 256 ^ 2 ) ) % 256) + ;
  378.                       CHR( INT( xValue / ( 256 ^ 3 ) ) % 256)
  379.          else 
  380.             xValue  := value + "" // force to string type
  381.             nAtNull := AT( CHR(0), xValue )
  382.             if ( nAtNull > 0 ) 
  383.                xValue := SUBSTR( xValue, 1, nAtNull + 1 )
  384.             else
  385.                xValue := xValue + CHR(0)
  386.             endif
  387.          endif
  388.  
  389.          // Write the data to the registry
  390.          nLen := LEN( xValue )
  391. #ifdef __asian__
  392.          if (nType == REG_SZ)
  393.             nResult := RegSetValueExChar(this.key, valueName, ;
  394.                          0, nType, xValue, nLen)
  395.          else 
  396. #endif
  397.             nResult := RegSetValueEx(this.key, valueName, ;
  398.                          0, nType, xValue, nLen)
  399. #ifdef __asian__
  400.          endif
  401. #endif
  402.  
  403. #ifdef DEBUG
  404. ? "setvalue - " + nResult
  405. #endif
  406.  
  407.          if (nResult == ERROR_SUCCESS)
  408.             bReturn := true
  409.          else
  410.             this.error = (lnResult)
  411.          endif
  412.          this.close()
  413.       endif
  414.    return (bReturn)
  415. endclass
  416.